home *** CD-ROM | disk | FTP | other *** search
-
- {*******************************************************}
- { }
- { Delphi Visual Component Library }
- { }
- { Copyright (c) 1996,98 Borland International }
- { }
- {*******************************************************}
-
- unit OleCtrls;
-
- {$R-}
-
- interface
-
- uses Windows, Messages, ActiveX, SysUtils, Classes, Controls, Forms,
- Menus, Graphics, ComObj, AxCtrls;
-
- type
-
- TOleControl = class;
-
- TEventDispatch = class(TObject, IUnknown, IDispatch)
- public
- constructor Create(Control: TOleControl);
- end;
-
- TOleEnum = type Smallint;
-
- TEnumValue = record
- Value: Longint;
- Ident: string;
- end;
-
- PEnumValueList = ^TEnumValueList;
- TEnumValueList = array[0..32767] of TEnumValue;
-
- TEnumPropDesc = class
- public
- constructor Create(DispID, ValueCount: Integer;
- const TypeInfo: ITypeInfo);
- destructor Destroy; override;
- procedure GetStrings(Proc: TGetStrProc);
- function StringToValue(const S: string): Integer;
- function ValueToString(V: Integer): string;
- end;
-
- PControlData = ^TControlData;
- TControlData = record
- ClassID: TGUID;
- EventIID: TGUID;
- EventCount: Longint;
- EventDispIDs: Pointer;
- LicenseKey: Pointer;
- Flags: Integer;
- Version: Integer;
- FontCount: Integer;
- FontIDs: PDispIDList;
- PictureCount: Integer;
- PictureIDs: PDispIDList;
- Reserved: Integer;
- InstanceCount: Integer;
- EnumPropDescs: TList;
- end;
-
- TOleControl = class(TWinControl, IUnknown, IOleClientSite,
- IOleControlSite, IOleInPlaceSite, IOleInPlaceFrame, IDispatch,
- IPropertyNotifySink, ISimpleFrameSite)
- protected
- FEvents: Integer;
- procedure CreateWnd; override;
- procedure DefaultHandler(var Message); override;
- procedure DefineProperties(Filer: TFiler); override;
- procedure DestroyWindowHandle; override;
- function GetByteProp(Index: Integer): Byte;
- function GetColorProp(Index: Integer): TColor;
- function GetTColorProp(Index: Integer): TColor;
- function GetCompProp(Index: Integer): Comp;
- function GetCurrencyProp(Index: Integer): Currency;
- function GetDoubleProp(Index: Integer): Double;
- function GetIDispatchProp(Index: Integer): IDispatch;
- function GetIntegerProp(Index: Integer): Integer;
- function GetIUnknownProp(Index: Integer): IUnknown;
- function GetWordBoolProp(Index: Integer): WordBool;
- function GetTDateTimeProp(Index: Integer): TDateTime;
- function GetTFontProp(Index: Integer): TFont;
- function GetOleBoolProp(Index: Integer): TOleBool;
- function GetOleDateProp(Index: Integer): TOleDate;
- function GetOleEnumProp(Index: Integer): TOleEnum;
- function GetTOleEnumProp(Index: Integer): TOleEnum;
- function GetOleVariantProp(Index: Integer): OleVariant;
- function GetTPictureProp(Index: Integer): TPicture;
- procedure GetProperty(Index: Integer; var Value: TVarData);
- function GetShortIntProp(Index: Integer): ShortInt;
- function GetSingleProp(Index: Integer): Single;
- function GetSmallintProp(Index: Integer): Smallint;
- function GetStringProp(Index: Integer): string;
- function GetVariantProp(Index: Integer): Variant;
- function GetWideStringProp(Index: Integer): WideString;
- function GetWordProp(Index: Integer): Word;
- procedure InitControlData; virtual; abstract;
- procedure InitControlInterface(const Obj: IUnknown); virtual;
- procedure InvokeMethod(const DispInfo; Result: Pointer);
- function PaletteChanged(Foreground: Boolean): Boolean; override;
- procedure PictureChanged(Sender: TObject);
- procedure SetByteProp(Index: Integer; Value: Byte);
- procedure SetColorProp(Index: Integer; Value: TColor);
- procedure SetTColorProp(Index: Integer; Value: TColor);
- procedure SetCompProp(Index: Integer; const Value: Comp);
- procedure SetCurrencyProp(Index: Integer; const Value: Currency);
- procedure SetDoubleProp(Index: Integer; const Value: Double);
- procedure SetIDispatchProp(Index: Integer; const Value: IDispatch);
- procedure SetIntegerProp(Index: Integer; Value: Integer);
- procedure SetIUnknownProp(Index: Integer; const Value: IUnknown);
- procedure SetName(const Value: TComponentName); override;
- procedure SetWordBoolProp(Index: Integer; Value: WordBool);
- procedure SetTDateTimeProp(Index: Integer; const Value: TDateTime);
- procedure SetTFontProp(Index: Integer; Value: TFont);
- procedure SetOleBoolProp(Index: Integer; Value: TOleBool);
- procedure SetOleDateProp(Index: Integer; const Value: TOleDate);
- procedure SetOleEnumProp(Index: Integer; Value: TOleEnum);
- procedure SetTOleEnumProp(Index: Integer; Value: TOleEnum);
- procedure SetOleVariantProp(Index: Integer; const Value: OleVariant);
- procedure SetParent(AParent: TWinControl); override;
- procedure SetTPictureProp(Index: Integer; Value: TPicture);
- procedure SetProperty(Index: Integer; const Value: TVarData);
- procedure SetShortIntProp(Index: Integer; Value: Shortint);
- procedure SetSingleProp(Index: Integer; const Value: Single);
- procedure SetSmallintProp(Index: Integer; Value: Smallint);
- procedure SetStringProp(Index: Integer; const Value: string);
- procedure SetVariantProp(Index: Integer; const Value: Variant);
- procedure SetWideStringProp(Index: Integer; const Value: WideString);
- procedure SetWordProp(Index: Integer; Value: Word);
- procedure WndProc(var Message: TMessage); override;
- property ControlData: PControlData;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure BrowseProperties;
- procedure DoObjectVerb(Verb: Integer);
- function GetEnumPropDesc(DispID: Integer): TEnumPropDesc;
- function GetHelpContext(Member: string; var HelpCtx: Integer;
- var HelpFile: string): Boolean;
- procedure GetObjectVerbs(List: TStrings);
- function GetPropDisplayString(DispID: Integer): string;
- procedure GetPropDisplayStrings(DispID: Integer; List: TStrings);
- function IsCustomProperty(DispID: Integer): Boolean;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
- procedure SetPropDisplayString(DispID: Integer; const Value: string);
- procedure ShowAboutBox;
- property OleObject: Variant;
- property DefaultDispatch: IDispatch;
- property TabStop default True;
- end;
-
- EOleCtrlError = class(Exception);
-
- function FontToOleFont(Font: TFont): Variant;
- procedure OleFontToFont(const OleFont: Variant; Font: TFont);
-
- implementation
-